home *** CD-ROM | disk | FTP | other *** search
/ Die Speccy' 97 / Die Speccy' 97.iso / amiga_system / the_aminet / comm / bbs / bbbbs85.lha / rexx / bbsFriends.rexx < prev    next >
OS/2 REXX Batch file  |  1995-01-18  |  5KB  |  244 lines
  1. /* $VER: bbsFriends.rexx 8.3 (18.1.95)
  2. copyright ⌐ 1994-95 Richard Lee Stockton
  3. BBBBS email alias handler
  4. FREELY DISTRIBUTABLE
  5. Thanks to John Ruckart for this idea and much of this code
  6. */
  7.  
  8. SIGNAL ON BREAK_C
  9.  
  10. ARG name colorflag .
  11.  
  12. IF ADDRESS()='BAUD' THEN
  13.   DO
  14.     CR='0D'x
  15.     frombb=1
  16.   END
  17. ELSE
  18.   DO
  19.     CR=''
  20.     frombb=0
  21.   END
  22.  
  23. def=''
  24. pen3=''
  25. IF colorflag=0 THEN
  26.   DO
  27.     def=''
  28.     pen3=''
  29.   END
  30. lineup='1B'x'M'
  31.  
  32. namemask=COMPRESS(XRANGE(),XRANGE('A','Z')' _-')
  33. bbspath=GETCLIP('BBS_path')
  34. aliasexclude='SYSOP BYE OFF FL QUICK'
  35. CALL loadFriends()
  36.  
  37. ch=''
  38. DO WHILE ch~='Q'
  39.   SAY CR
  40.   SAY pen3||LEFT('=',75,'=')def||CR
  41.   SAY CENTER('F R I E N D S - L I S T',75)||CR
  42.   SAY CR
  43.   SAY CENTER('A L I A S   E D I T O R',75)||CR
  44.   SAY pen3||LEFT('=',75,'=')def||CR
  45.   SAY CR
  46.   SAY '                           'pen3'W - 'def'What is the Friends List? 'CR
  47.   SAY '                           'pen3'A - 'def'Add an Alias 'CR
  48.   SAY '                           'pen3'D - 'def'Delete an Alias 'CR
  49.   SAY '                           'pen3'V - 'def'View my Aliases 'CR
  50.   SAY '                           'pen3'Q - 'def'Quit to previous menu'CR
  51.   SAY CR
  52.   ch=getinput(1 1 pen3'Enter Choice > 'def)
  53.   SELECT
  54.     WHEN ch='W' THEN CALL whatFriends()
  55.     WHEN ch='A' THEN CALL addalias()
  56.     WHEN ch='D' THEN CALL delalias()
  57.     WHEN ch='V' THEN CALL viewalias()
  58.     WHEN ch='Q' THEN CALL saveFriends()
  59.     OTHERWISE SAY 'No such command'CR
  60.   END
  61. END
  62. EXIT
  63.  
  64.  
  65. loadFriends:
  66. CALL MAKEDIR(bbspath'Friends')
  67. alias.=''
  68. alias.0=0
  69. realname.=''
  70. CALL CLOSE(f)
  71. IF OPEN(f,bbspath'Friends/'name,'R')=0 THEN RETURN 1
  72. DO i=1
  73.   line=READLN(f)
  74.   IF EOF(f) THEN LEAVE i
  75.   alias.i=WORD(line,1)
  76.   realname.i=WORD(line,2)
  77. END
  78. alias.0=i-1
  79. CALL CLOSE(f)
  80. RETURN 1
  81.  
  82.  
  83. saveFriends:
  84. frn=bbspath'Friends/'name
  85. IF alias.0<1 THEN
  86.   DO
  87.     CALL DELETE(frn)
  88.     RETURN
  89.   END
  90. CALL OPEN(f,frn,'W')
  91. DO i=1 TO alias.0
  92.   CALL WRITELN(f,alias.i'  'realname.i)
  93. END
  94. CALL CLOSE(f)
  95. RETURN
  96.  
  97.  
  98. whatFriends:
  99. IF OPEN(f,bbspath'Information/BBBBS.Friends','R')=0 THEN RETURN
  100. SAY CR
  101. DO i=1
  102.   SAY READLN(f)||CR
  103.   IF EOF(f) THEN LEAVE i
  104. END
  105. CALL CLOSE(f)
  106. CALL getinput(1 1 pen3'                          RETURN=Continue 'def)
  107. SAY CR
  108. RETURN
  109.  
  110.  
  111. addalias:
  112. match=0
  113. username=getinput(1 0 pen3'Enter Users Email Name > 'def)
  114. username=cleanstring(1':'username)
  115. IF username='' THEN RETURN
  116. IF ~EXISTS(bbspath'Users/'username) THEN 
  117.  DO
  118.   SAY 'Username not found'CR
  119.   RETURN
  120.  END 
  121. newalias=getinput(1 0 pen3'Enter an Alias for'def' 'username def'> ')
  122. IF newalias='' THEN RETURN
  123. IF alias.0>0 THEN
  124.   DO i=1 TO alias.0
  125.    IF UPPER(alias.i)=UPPER(newalias) THEN match=1
  126.   END
  127. IF FIND(aliasexclude,UPPER(newalias))>0 THEN match=2
  128. IF match=0 THEN 
  129.   DO 
  130.    alias.0=alias.0+1
  131.    num=alias.0
  132.    alias.num=newalias
  133.    realname.num=username
  134.    SAY alias.num 'alias as ' realname.num 'added'CR
  135.   END
  136. ELSE IF match=1 THEN SAY 'Alias 'newalias' already exists'CR
  137. ELSE SAY newalias ' is a reserved name'CR
  138. RETURN
  139.  
  140.  
  141. delalias:
  142. match=0
  143. dalias=getinput(1 0 pen3'Enter Alias to Delete > 'def)
  144. dalias=UPPER(WORD(dalias,1))
  145. IF alias.0>0 THEN
  146.   DO i=1 TO alias.0
  147.    IF UPPER(alias.i)=UPPER(dalias) THEN 
  148.     DO 
  149.      match=1
  150.      num=i
  151.      LEAVE i
  152.     END
  153.   END
  154. IF match=1 THEN 
  155.  DO
  156.   IF getinput(1 1 'Really Delete 'dalias'? (Ny) > ')='Y' THEN
  157.    DO
  158.     DO i=num TO alias.0
  159.      j=i+1
  160.      alias.i=alias.j
  161.      realname.i=realname.j
  162.     END
  163.     alias.0=alias.0-1
  164.    END
  165.  END
  166. ELSE SAY dalias' not Found.'CR
  167. RETURN
  168.  
  169.  
  170. viewalias:
  171. IF alias.0>0 THEN
  172. DO i=1 TO alias.0
  173.  SAY RIGHT(alias.i,22) 'is' realname.i||CR
  174. END
  175. ELSE SAY 'No Aliases assigned'CR
  176. CALL getinput(1 1 pen3'                          RETURN=Continue 'def)
  177. SAY CR
  178. RETURN
  179.  
  180.  
  181. getinput:
  182. PARSE ARG upflag' 'oneflag' 'pline
  183. CALL checkdcd()
  184. OPTIONS PROMPT pline
  185. PARSE PULL inarg
  186. inarg=STRIP(inarg)
  187. IF upflag THEN inarg=UPPER(inarg)
  188. IF oneflag THEN inarg=LEFT(inarg,1)
  189. inarg=cleanstring(0':'inarg)
  190. RETURN inarg
  191.  
  192.  
  193. checkdcd:
  194. IF ~frombb THEN RETURN
  195. dcd
  196. IF RC=0 THEN
  197.   DO
  198.     DO dcds=1 TO 3  /* 5 second delay */
  199.       CALL DELAY(50)
  200.       dcd
  201.       IF RC~=0 THEN RETURN
  202.     END
  203.     dcd
  204.     IF RC=0 THEN EXIT
  205.   END
  206. RETURN
  207.  
  208.  
  209. cleanstring:
  210. PARSE ARG nflag':'cstr
  211. IF nflag=1 THEN
  212.   DO
  213.     cstr=COMPRESS(cstr,"'`")
  214.     cstr=TRANSLATE(cstr,,namemask)
  215.     cstr=SPACE(cstr,1,'_')
  216.     RETURN cstr
  217.   END
  218. bot=XRANGE(,'1F'x)
  219. cstr=strip_ansi(cstr)
  220. top=XRANGE('7F'x)
  221. cstr=COMPRESS(cstr,bot||top)
  222. IF nflag=0 THEN cstr=STRIP(cstr)
  223. RETURN cstr
  224.  
  225.  
  226. strip_ansi:
  227. PARSE ARG aline 
  228. n=POS('1B'x,aline)
  229. DO WHILE n>0
  230.   DO k=2
  231.     IF DATATYPE(SUBSTR(aline,n+k,1),'M') | (n+k+1)>LENGTH(aline) THEN
  232.       leave k
  233.   END
  234.   aline=DELSTR(aline,n,k+1)
  235.   n=POS('1B'x,aline)
  236. END
  237. RETURN aline
  238.  
  239.  
  240. BREAK_C:
  241. EXIT
  242.  
  243. /* bbsFriends.rexx */
  244.